home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / EDWIN / INITMAC.S < prev    next >
Encoding:
Text File  |  1993-06-15  |  2.8 KB  |  66 lines
  1. ;;;
  2. ;;;    Copyright (c) 1985 Massachusetts Institute of Technology
  3. ;;;
  4. ;;;    This material was developed by the Scheme project at the
  5. ;;;    Massachusetts Institute of Technology, Department of
  6. ;;;    Electrical Engineering and Computer Science.  Permission to
  7. ;;;    copy this software, to redistribute it, and to use it for any
  8. ;;;    purpose is granted, subject to the following restrictions and
  9. ;;;    understandings.
  10. ;;;
  11. ;;;    1. Any copy made of this software must include this copyright
  12. ;;;    notice in full.
  13. ;;;
  14. ;;;    2. Users of this software agree to make their best efforts (a)
  15. ;;;    to return to the MIT Scheme project any improvements or
  16. ;;;    extensions that they make, so that these may be included in
  17. ;;;    future releases; and (b) to inform MIT of noteworthy uses of
  18. ;;;    this software.
  19. ;;;
  20. ;;;    3.  All materials developed as a consequence of the use of
  21. ;;;    this software shall duly acknowledge such use, in accordance
  22. ;;;    with the usual standards of acknowledging credit in academic
  23. ;;;    research.
  24. ;;;
  25. ;;;    4. MIT has made no warrantee or representation that the
  26. ;;;    operation of this software will be error-free, and MIT is
  27. ;;;    under no obligation to provide any services, by way of
  28. ;;;    maintenance, update, or otherwise.
  29. ;;;
  30. ;;;    5.  In conjunction with products arising from the use of this
  31. ;;;    material, there shall be no use of the name of the
  32. ;;;    Massachusetts Institute of Technology nor of any adaptation
  33. ;;;    thereof in any advertising, promotional, or sales literature
  34. ;;;    without prior written consent from MIT in each case.
  35. ;;;
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37. ;;;
  38. ;;;     Modified by Texas Instruments Inc 8/15/85
  39. ;;;
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41.  
  42. (macro define-initial-command-key
  43.   (lambda (e)
  44.     (let ((bvl (cadr e))
  45.           (description (caddr e))
  46.           (key-commands (cadddr e))
  47.           (body (cddddr e)))
  48.       (let ((name (car bvl))
  49.             (arg-names (mapcar (lambda (arg) (if (pair? arg) (car arg) arg))
  50.                                (cdr bvl)))
  51.             (arg-inits (mapcar (lambda (arg)
  52.                                  (if (pair? arg) (cadr arg) #F))
  53.                                (cdr bvl))))
  54.         (let ((procedure-name
  55.                 (string->symbol (string-append (canonicalize-name-string name)
  56.                                                "-COMMAND"))))
  57.           `(begin
  58.              (let ()
  59.                (define (procedure ,@arg-names)
  60.                         ,@(map2 (lambda (arg-name arg-init)
  61.                                   `(if (not ,arg-name)
  62.                                        (set! ,arg-name ,arg-init)))
  63.                                 arg-names arg-inits)
  64.                         ,@body)
  65.                ,@key-commands)))))))
  66.